home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Libraries / SAT 2.3.8 / Libraries & Documentation / Add-ons / Graphic effects / GammaFade.p < prev    next >
Text File  |  1995-11-10  |  13KB  |  428 lines
  1. unit GammaFade;
  2.  
  3. {--------------------------------------------------------------------------------------------------------------- }
  4. { File "gamma.p" - Source for Altering the Gamma Tables of GDevices from Gamma.c                                 }
  5. {   Last updated 6/29/95, MJS                                                                                     }
  6. {--------------------------------------------------------------------------------------------------------------- }
  7. {    7-13-95    ported to pascal  by Matthew Xavier Mora mxmora@mxmdesigns.com                                         }
  8. {     7-18-95     fixed all the porting bugs and got it to work in think pascal                                     }
  9. {----------------------------------------------------------------------------------------------------------------}
  10. {     7-18-95 ported to CW (68k and PPC) by Bill Catambay (pretty easy), cleaned the code a bit (no more labels),     }
  11. {           brought back Matthew's delay fade routines (in main program).                                             }
  12. {----------------------------------------------------------------------------------------------------------------}
  13. {    august -95: Change by Ingemar R: Moved the FadeToBlack and FadeFromBlack calls to}
  14. {        this unit and modified them to be timed by TickCount and aborted by mouse clicks.}
  15. {        DoGammaFade now auto-initializes - no call to SetupGammaTools is needed.}
  16. {        You can use FadeToBlack and FadeFromBlack only. They both check for gamma tables}
  17. {        to be available, so you don't have to call IsGammaAvailable yourself.}
  18. {        These changes were made when making a SAT add-on unit of it.}
  19.  
  20.  
  21. {---------------------------------------------------------------------------------------------------------------}
  22. {    This is the Source Code for the Gamma Utils Library file. Use this to build                                    }
  23. {        new functionality into the library or make an A4-based library.                                         }
  24. {    See the header file "gamma.h" for much more information. -- MJS                                                }
  25. {---------------------------------------------------------------------------------------------------------------}
  26.  
  27. interface
  28.  
  29.     uses
  30. {$IFC UNDEFINED THINK_PASCAL}
  31.         ToolUtils, Devices, 
  32. {$ENDC}
  33.         Traps, Video;
  34.  
  35. { Function Prototypes}
  36.  
  37.     function IsGammaAvailable: Boolean;
  38.     function IsOneGammaAvailable (theGDevice: GDHandle): Boolean;
  39.  
  40. {    These routines help you determine whether you can use the Gamma Table Utils}
  41. {        on the current machine. The first checks all attached monitors, and the }
  42. {        second just checks the indicated monitor. Each returns TRUE if you can }
  43. {        use the functions, or FALSE if you can't. • Note: Before calling any other}
  44. {        Gamma Table function below, use this function to see if you are allowed.}
  45.  
  46. { * ****************************************************************************** *}
  47.  
  48.     function SetupGammaTools: OSErr;
  49.     function DisposeGammaTools: OSErr;
  50.  
  51. {    These routines must bracket any calls to the Gamma Table functions, perhaps}
  52. {        at the head and tail of your main(). The first sets up the data structures}
  53. {        necessary to save and restore the state of your monitors. The second}
  54. {        disposes of all the internal data structures, but does not reset the}
  55. {        monitors to their original states. Both return the error code if some}
  56. {        part failed. }
  57.  
  58. { * ****************************************************************************** *}
  59.  
  60.     function DoGammaFade (percent: Integer): OSErr;
  61.     function DoOneGammaFade (theGDevice: GDHandle; percent: Integer): OSErr;
  62.  
  63.  
  64. {    Use the first function to Fade each of your monitors to some percentage of their}
  65. {        initial brightness (100 = bright, 0 = dim). Repeatedly call this to ramp your}
  66. {        monitors up or down. The second function performs the same function, but only}
  67. {        for the specified monitor. Both return any applicable error codes.}
  68. {    Be sure to set up the necessary save-state data structures before you start by}
  69. {        calling the compatibility and initialization functions. }
  70.  
  71. { * ****************************************************************************** *}
  72.  
  73. {function GetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;}
  74. {function SetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;}
  75.  
  76.  
  77. {    These routines are low-level interfaces to the device drivers for the monitors.}
  78. {        Use them at your own risk.}
  79. {NO LONGER EXPORTED! /Ingemar}
  80.  
  81.  
  82. {Quick fixed-time calls:}
  83.  
  84.     procedure FadeToBlack (ticks: Longint);
  85.     procedure FadeFromBlack (ticks: Longint);
  86.  
  87.  
  88. implementation
  89.  
  90.     const
  91.         kGammaUtilsSig = 'GAMA';
  92.         kGetDeviceListTrapNum = $AA29;
  93.  
  94.     type
  95.         GlobalGammasPtr = ^GlobalGammas;
  96.         GlobalGammasHdl = ^GlobalGammasPtr;
  97.         GlobalGammas = record
  98.                 size, dataOffset: Integer;
  99.                 saved, hacked: GammaTblHandle;
  100.                 theGDevice: GDHandle;
  101.                 next: GlobalGammasHdl;
  102.             end;
  103.         GammaData = packed array[0..100000] of Byte;  {used to set the gamma}
  104.         GammaDataPtr = ^GammaData;
  105.  
  106.     var
  107.         gammaUtilsInstalled: OSType;
  108.         gammaTables: GlobalGammasHdl;
  109.  
  110.     function GetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
  111.     forward;
  112.     function SetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
  113.     forward;
  114.  
  115.  
  116.  
  117. {Fixed-time fading routines that can be aborted with a mouse click.}
  118.  
  119.     procedure FadeToBlack (ticks: Longint);
  120.         var
  121.             i: integer;
  122.             oe: OSErr;
  123.             startTicks: Longint;
  124.     begin
  125.         if not IsGammaAvailable then
  126.             Exit(FadeToBlack);
  127.         startTicks := TickCount;
  128.         while TickCount < startTicks + ticks do
  129.             begin
  130.                 i := 100 * (startTicks + ticks - TickCount) div ticks;
  131.                 oe := DoGammaFade(i);
  132.  
  133.                 if Button then
  134.                     begin
  135.                         oe := DoGammaFade(0);
  136.                         Exit(FadeToBlack);
  137.                     end;
  138.             end;
  139.         oe := DoGammaFade(0);
  140.     end; {FadeToBlack}
  141.  
  142.     procedure FadeFromBlack (ticks: Longint);
  143.         var
  144.             i: integer;
  145.             oe: OSErr;
  146.             startTicks: Longint;
  147.     begin
  148.         if not IsGammaAvailable then
  149.             Exit(FadeFromBlack);
  150.         startTicks := TickCount;
  151.         while TickCount < startTicks + ticks do
  152.             begin
  153.                 i := 100 - 100 * (startTicks + ticks - TickCount) div ticks;
  154.                 oe := DoGammaFade(i);
  155.  
  156.                 if Button then
  157.                     begin
  158.                         oe := DoGammaFade(100);
  159.                         Exit(FadeFromBlack);
  160.                     end;
  161.             end;
  162.         oe := DoGammaFade(100);
  163.     end; {FadeFromBlack}
  164.  
  165.  
  166.  
  167.  
  168.     function IsGammaAvailable: Boolean;
  169.         var
  170.             theGDevice: GDHandle;
  171.     begin
  172.         IsGammaAvailable := false;
  173.         if (NGetTrapAddress(kGetDeviceListTrapNum, ToolTrap) = NGetTrapAddress(_Unimplemented, ToolTrap)) then
  174.             exit(IsGammaAvailable);
  175.         theGDevice := GetDeviceList;
  176.         while (theGDevice <> nil) do
  177.             begin
  178.                 if (TestDeviceAttribute(theGDevice, screenDevice) and TestDeviceAttribute(theGDevice, noDriver)) then
  179.                     exit(IsGammaAvailable);
  180.                 if (theGDevice^^.gdType = fixedType) then
  181.                     exit(IsGammaAvailable);
  182.                 theGDevice := GetNextDevice(theGDevice);
  183.             end;
  184.         IsGammaAvailable := true; {If we made it this far then its true}
  185.     end;
  186.  
  187.  
  188.     function IsOneGammaAvailable (theGDevice: GDHandle): Boolean;
  189.     begin
  190.         IsOneGammaAvailable := false;
  191.         if (NGetTrapAddress(kGetDeviceListTrapNum, ToolTrap) = NGetTrapAddress(_Unimplemented, ToolTrap)) then
  192.             exit(IsOneGammaAvailable);
  193.         if (TestDeviceAttribute(theGDevice, screenDevice) and TestDeviceAttribute(theGDevice, noDriver)) then
  194.             exit(IsOneGammaAvailable);
  195.         if (theGDevice^^.gdType = fixedType) then
  196.             exit(IsOneGammaAvailable);
  197.         IsOneGammaAvailable := true;
  198.     end;
  199.  
  200.     function SetupGammaTools: OSErr;
  201.         var
  202.             errorCold: OSErr;
  203.             tempHdl: GlobalGammasHdl;
  204.             masterGTable: GammaTblPtr;
  205.             theGDevice: GDHandle;
  206.     begin
  207.         if (gammaUtilsInstalled = kGammaUtilsSig) then
  208.             begin
  209.                 SetupGammaTools := -1;
  210.                 exit(SetupGammaTools);
  211.             end;
  212.         gammaTables := nil;
  213.         gammaUtilsInstalled := kGammaUtilsSig;
  214.         theGDevice := GetDeviceList;
  215.         while (theGDevice <> nil) do
  216.             begin
  217.                 errorCold := GetDevGammaTable(theGDevice, masterGTable);
  218.                 if (errorCold <> 0) then
  219.                     begin
  220.                         SetupGammaTools := errorCold;
  221.                         exit(SetupGammaTools);
  222.                     end;
  223.                 tempHdl := globalGammasHdl(NewHandle(sizeof(globalGammas)));
  224.                 if (tempHdl = nil) then
  225.                     begin
  226.                         SetupGammaTools := MemError;
  227.                         exit(SetupGammaTools);
  228.                     end;
  229.                 with masterGTable^ do
  230.                     begin
  231.                         tempHdl^^.size := sizeof(GammaTbl) + gFormulaSize + (gChanCnt * gDataCnt * gDataWidth div 8);
  232.                         tempHdl^^.dataOffset := gFormulaSize;
  233.                         tempHdl^^.theGDevice := theGDevice;
  234.                     end;
  235.                 tempHdl^^.saved := GammaTblHandle(NewHandle(tempHdl^^.size));
  236.                 if (tempHdl^^.saved = nil) then
  237.                     begin
  238.                         SetupGammaTools := MemError;
  239.                         exit(SetupGammaTools);
  240.                     end;
  241.                 tempHdl^^.hacked := GammaTblHandle(NewHandle(tempHdl^^.size));
  242.                 if (tempHdl^^.hacked = nil) then
  243.                     begin
  244.                         SetupGammaTools := MemError;
  245.                         exit(SetupGammaTools);
  246.                     end;
  247.                 BlockMove(Ptr(masterGTable), Ptr(tempHdl^^.saved^), tempHdl^^.size);
  248.                 tempHdl^^.next := gammaTables;
  249.                 gammaTables := tempHdl;
  250.                 theGDevice := GetNextDevice(theGDevice)
  251.             end;
  252.         SetupGammaTools := 0;
  253.     end;
  254.  
  255.     function DoGammaFade (percent: Integer): OSErr;
  256.         var
  257.             errorCold: OSErr;
  258.             thesize, i, theNum: LongInt;
  259.             tempHdl: GlobalGammasHdl;
  260.             dataPtr: Ptr;
  261.             tempGammaTbl: GammaTblPtr;
  262.             gdp: GammaDataPtr;
  263.             tempLong: Longint;
  264.     begin
  265.         if gammaUtilsInstalled <> kGammaUtilsSig then
  266.             errorCold := SetupGammaTools;
  267.         if gammaUtilsInstalled <> kGammaUtilsSig then
  268.             begin
  269.                 DoGammaFade := -1;
  270.                 exit(DoGammaFade);
  271.             end;
  272.         tempHdl := gammaTables;
  273.         while (tempHdl <> nil) do
  274.             begin
  275.                 with tempHdl^^ do
  276.                     begin
  277.                         BlockMove(Ptr(saved^), Ptr(hacked^), size);
  278.                         tempLong := ord(@hacked^^.gFormulaData) + dataOffset;
  279.                         gdp := gammaDataPtr(ord(@hacked^^.gFormulaData) + dataOffset);
  280.                         thesize := hacked^^.gChanCnt * hacked^^.gDataCnt;
  281.                     end;
  282.                 for i := 0 to thesize - 1 do
  283.                     begin
  284.                         theNum := gdp^[i];
  285.                         theNum := (theNum * percent) div 100;
  286.                         gdp^[i] := theNum;
  287.                     end;
  288.                 errorCold := SetDevGammaTable(tempHdl^^.theGDevice, tempHdl^^.hacked^);
  289.                 if (errorCold <> 0) then
  290.                     begin
  291.                         DoGammaFade := errorCold;
  292.                         exit(DoGammaFade);
  293.                     end;
  294.                 tempHdl := tempHdl^^.next;
  295.             end;
  296.         DoGammaFade := 0;
  297.     end;
  298.  
  299.     function DoOneGammaFade (theGDevice: GDHandle; percent: Integer): OSErr;
  300.         var
  301.             errorCold: OSErr;
  302.             thesize, i, theNum: LongInt;
  303.             tempHdl: GlobalGammasHdl;
  304.             gdp: GammaDataPtr;
  305.     begin
  306.         if gammaUtilsInstalled <> kGammaUtilsSig then
  307.             errorCold := SetupGammaTools;
  308.         if gammaUtilsInstalled <> kGammaUtilsSig then
  309.             begin
  310.                 DoOneGammaFade := -1;
  311.                 Exit(DoOneGammaFade);
  312.             end;
  313.         tempHdl := gammaTables;
  314.         while ((tempHdl <> nil) and (theGDevice <> tempHdl^^.theGDevice)) do
  315.             tempHdl := tempHdl^^.next;
  316.         with tempHdl^^ do
  317.             begin
  318.                 BlockMove(Ptr(saved^), Ptr(hacked^), size);
  319.                 gdp := gammaDataPtr(ord(@hacked^^.gFormulaData) + dataOffset);
  320.                 thesize := hacked^^.gChanCnt * hacked^^.gDataCnt;
  321.             end;
  322.         for i := 0 to thesize - 1 do
  323.             begin
  324.                 theNum := gdp^[i];
  325.                 theNum := (theNum * percent) div 100;
  326.                 gdp^[i] := theNum;
  327.             end;
  328.         errorCold := SetDevGammaTable(tempHdl^^.theGDevice, tempHdl^^.hacked^);
  329.         DoOneGammaFade := errorCold;
  330.     end;
  331.  
  332.     function DisposeGammaTools: OSErr;
  333.         var
  334.             tempHdl, nextHdl: GlobalGammasHdl;
  335.     begin
  336.         if gammaUtilsInstalled <> kGammaUtilsSig then
  337.             begin
  338.                 DisposeGammaTools := -1;
  339.                 Exit(DisposeGammaTools);
  340.             end;
  341.         tempHdl := gammaTables;
  342.         while (tempHdl <> nil) do
  343.             begin
  344.                 HLock(Handle(tempHdl));
  345.                 with tempHdl^^ do
  346.                     begin
  347.                         nextHdl := next;
  348.                         DisposeHandle(Handle(saved));
  349.                         DisposeHandle(Handle(hacked));
  350.                         HUnLock(Handle(tempHdl));
  351.                         DisposeHandle(Handle(tempHdl));
  352.                         tempHdl := nextHdl;
  353.                     end;
  354.             end;
  355.         gammaUtilsInstalled := '    ';
  356.         DisposeGammaTools := 0;
  357.     end;
  358.  
  359.     function GetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
  360.         var
  361.             errorCold: OSErr;
  362.             myCPB: ParmBlkPtr;
  363.     begin
  364.         theTable := nil;
  365.         if not IsOneGammaAvailable(theGDevice) then
  366.             begin
  367.                 GetDevGammaTable := -1;
  368.                 exit(GetDevGammaTable);
  369.             end;
  370.         myCPB := ParmBlkPtr(NewPtrClear(sizeof(ParamBlockRec)));
  371.         if (myCPB = nil) then
  372.             begin
  373.                 GetDevGammaTable := MemError;
  374.                 exit(GetDevGammaTable);
  375.             end;
  376.         myCPB^.csCode := cscGetGamma;
  377.         myCPB^.ioCRefNum := theGDevice^^.gdRefNum;
  378.         myCPB^.csParam[0] := HiWord(longint(@theTable));
  379.         myCPB^.csParam[1] := LoWord(longint(@theTable));
  380. {$IFC UNDEFINED THINK_PASCAL}
  381.         errorCold := PBStatusSync(myCPB);
  382. {$ELSEC}
  383.         errorCold := PBStatus(myCPB, false);
  384. {$ENDC}
  385.         DisposePtr(Ptr(myCPB));
  386.         GetDevGammaTable := errorCold;
  387.     end;
  388.  
  389.     function SetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
  390.         var
  391.             myCPB: ParmBlkPtr;
  392.             errorCold: OSErr;
  393.             cTab: CTabHandle;
  394.             saveGDevice: GDHandle;
  395.     begin
  396.         if not IsOneGammaAvailable(theGDevice) then
  397.             begin
  398.                 SetDevGammaTable := -1;
  399.                 exit(SetDevGammaTable);
  400.             end;
  401.         myCPB := ParmBlkPtr(NewPtrClear(sizeof(ParamBlockRec)));
  402.         if (myCPB = nil) then
  403.             begin
  404.                 SetDevGammaTable := MemError;
  405.                 exit(SetDevGammaTable);
  406.             end;
  407.         myCPB^.csCode := cscSetGamma;
  408.         myCPB^.ioCRefNum := theGDevice^^.gdRefNum;
  409.         myCPB^.csParam[0] := HiWord(longint(@theTable));
  410.         myCPB^.csParam[1] := LoWord(longint(@theTable));
  411. {$IFC UNDEFINED THINK_PASCAL}
  412.         errorCold := PBControlSync(myCPB);
  413. {$ELSEC}
  414.         errorCold := PBControl(myCPB, false);
  415. {$ENDC}
  416.         if (errorCold = 0) then
  417.             begin
  418.                 saveGDevice := GetGDevice;
  419.                 SetGDevice(theGDevice);
  420.                 cTab := theGDevice^^.gdPMap^^.pmTable;
  421.                 SetEntries(0, cTab^^.ctSize, cTab^^.ctTable);
  422.                 SetGDevice(saveGDevice);
  423.             end;
  424.         DisposePtr(Ptr(myCPB));
  425.         SetDevGammaTable := errorCold;
  426.     end;
  427.  
  428. end.